Sentiment Analysis for Persian Text

In this project, we are going to develop very basic methodologies for sentiment analysis including Logistic Regression, Naive Bayes, and Vector Space Classification and test their performance on a dataset I have found online. There are multiple R packages that are needed for this project. You can use the code install.packages(“Package Name”) to install the packages listed below.

library(rwhatsapp)
library(PersianStemmer)
library(plotly)
library(ggplot2)
library(wordcloud2)

Loading & Preparing the data

loading the DigiKala data related to iPhone that I have found online.

dat = read.csv("Data.txt", header = T, encoding = "UTF-8")
#at=read_excel("Data.xlsx")
dat=na.omit(dat)

By considering the label “1” as “Positive” and the rest of the labels as “Negative”, we are preparing the data for creating a model for detecting the sentiments from a comment.

Corpus=lookup_emoji(dat$Text, text_field = "text")
Text = Corpus$text
Emoji = Corpus$emoji
Y=as.numeric(dat$Suggestion==1)

Defining functions for text cleaning, building up a dictionary, and extracitng features. First, the function that prepares the text for the analysis.

RefineText<- function(tex){
  n=length(tex)
  TextAd=c()
  
  #progress bar
  pb = txtProgressBar(min = 0, max = n, initial = 0,
                      style = 3, width = 50, char = "=") 
  
  for (i in 1:n) {
    tex[i] = RefineChars(tex[i]) 
    tex[i] = gsub("[\r\n]", "", tex[i])
    tex[i] = gsub('[[:punct:] ]+',' ', tex[i])
    tex[i] = RefineChars(tex[i])
        
    #,"@","$","%","&","*","،",".....","..."
    if (!(is.na(tex[i]))){
      if (all(tex[i]!=c(""," ","،","،,","‌"))){
        TextAd[i] = PerStem(tex[i], NoEnglish = F, NoNumbers = F,
                        NoStopwords = T, NoPunctuation = T,
                        StemVerbs = T, NoPreSuffix = T,
                    Context = T, StemBrokenPlurals = T,
                    Transliteration = F)
      }
    }
    setTxtProgressBar(pb,i)
  }
return(TextAd)
}

Now, it is time to build up a dictionary.

BuildFreqs <- function(corpus,y) {
  n = length(y)
d=1 # dictionary word numerator
freqs=matrix(c(0,0),ncol = 2) #frequencies for each word
colnames(freqs)=c("Neg","Pos")
Dict=c() 
t=c()
e=c()
tex = corpus$text
emoji = corpus$emoji
#refining Text removing numbers, stop words, punctuation, and so
#Progress bar
pb = txtProgressBar(min = 0, max = n, initial = 0, style = 3, width = 50, char = "=")
for (i in 1:n) {
  t = sort(table(unlist(strsplit(tex[i], " "))), decreasing = TRUE)
  
  #Building freqs for words
  for (j in 1:length(t)) {
    cond = (Dict == names(t)[j])
    if  (any(cond)) {
      wh = which(cond)
      freqs[wh+1,(y[i]+1)] = freqs[wh+1,(y[i]+1)]+t(j) # Adding Frequency
    } else if(is.null(names(t))==F) {
      Dict[d] = names(t)[j]
      if (y[i]==1) {
        freqs = rbind(freqs,c(0,1)) # Defining Frequency
      } else {
        freqs = rbind(freqs,c(1,0)) # Defining Frequency 
      }
      d = d+1
    }
  }
  
  if(is.null(emoji[[i]])==F){
    e = table(emoji[i])
    
    #Building frequencies for emojis
    for (j in 1:length(e)) {
      cond = (Dict == names(e)[j])
      if  (any(cond)) {
        wh = which(cond)
        freqs[wh+1,(y[i]+1)] = freqs[wh+1,(y[i]+1)]+e[j] 
        # Adding Frequency
      } else if(is.null(names(e))==F) {
        Dict[d] = names(e)[j]
        if (y[i]==1) {
          freqs = rbind(freqs,c(0,1)) # Defining Frequency
        } else {
          freqs = rbind(freqs,c(1,0)) # Defining Frequency 
        }
        
        d = d+1
      }
    }
  }
  
  setTxtProgressBar(pb,i)
}
Dictionary=list("Words"=Dict,"Frequencies"=freqs[-1,])
  return(Dictionary)
}

Finally, a function that uses the dictionary to extract features.

ExtractFeatures <- function(corpus, dict){
  
  tex = corpus$text
  emoji = corpus$emoji
  
  Words=dict$Words
  dict$Frequencies = dict$Frequencies/rowSums(dict$Frequencies)
  Frequencies=dict$Frequencies
  
  #Progress bar
  n = length(tex)
  pb = txtProgressBar(min = 0, max = n, initial = 0, style = 3,
width = 50, char = "=")
  
   x = matrix(rep(0,n*3),nrow =n ,ncol=3)
  for (i in 1:n) {
    wordlist = names(sort(table(unlist(strsplit(tex[i], " "))), 
                          decreasing = TRUE))
    if(is.null(emoji[[i]])==F){append(wordlist,table(emoji[i]))}
    x[i,1] = 1 #bias term is set to 1
    # loop through each word in the list of words
    for (word in wordlist){ 
      if (any(Words==word)) {
        # increment the word count for the neutral label 0
        x[i,2] = x[i,2]+Frequencies[which(Words==word),1]
       # increment the word count for the positive label 1
        x[i,3] = x[i,3]+Frequencies[which(Words==word),2]
      }
    }
    setTxtProgressBar(pb,i)
  }
 return(x) 
}

Using the functions defined, we are going to clean our Persian text, then build a dictionary, and extract features from the text.

TextAd=RefineText(Text)

Dictionary=BuildFreqs(list("text"=TextAd,"emoji"=Emoji),Y)

X = ExtractFeatures(list("text"=TextAd,"emoji"=Emoji), Dictionary)

Checking the features interpretability

To see, weather it is possible to to classify our text using the features we built, We must check the below scatter plot.

mylabel <- c("Train Pos", "Train Neg")
colors <- c("blue", "red")
xlabel = "Sum of Negative Words"
ylabel = "Sum of Positive Words"
plot_ly(x=X[,2],y=X[,3],
        symbols = c('x','o'),
        marker = list(size = 10),
        text= c(1:length(Y)), hoverinfo = "text",
        type="scatter",mode="markers", color=as.factor(Y),colors = c("red",  "green")) %>%
        layout(title = "Comments by the Features built",
               autosize = F, width = 920, height = 500)

The first classification method that is widely being used as a trivial and easy-to-implement methodology is Naive Bayes. In the following lines of code, we are going to build two functions by which we can use this method for our data.

ExtractSense=function(corpus, dict){
  
  tex = corpus$text
  emoji = corpus$emoji
  
  Words=dict$Words
  Frequencies=dict$Frequencies
  
  d=length(dict$Words)
  n=length(tex)
  
  #Laplacian Smoothing
  Freqs=1/(colSums(Frequencies)+d)*(t(Frequencies)+1)
  Freqs=t(Freqs)
  
  p_w_pos=Freqs[,2]
  p_w_neg=Freqs[,1]
  
  loglikelihood = log(p_w_pos/p_w_neg)
  
  p=rep(0,n)
  
  pb = txtProgressBar(min = 0, max = n, initial = 0, style = 3,
width = 50, char = "=")
  
  for(i in 1:n){
    
    wordlist = sort(table(unlist(strsplit(tex[i], " "))), decreasing = TRUE)
    if(is.null(emoji[[i]])==F){append(wordlist,table(emoji[i]))}
    
    for (j in 1:length(wordlist)){
      if  (any(Words == names(wordlist)[j])) {
        p[i]=p[i]+wordlist[j]*loglikelihood[Words == names(wordlist)[j]]
      }
    }
    setTxtProgressBar(pb,i)
  }
  return(p)
}

And, the predictior function will be defined like this:

Now, we want to use this method on our data to build a feature called “Sense” that measures the intensity of each comment alongside their polarity.

Sense=ExtractSense(list("text"=TextAd,"emoji"=Emoji), Dictionary)

We can see below how this feature looks like.

plot_ly(x=1:length(Sense),y=Sense, type = 'bar') %>%
  layout(title = "Overal Polarity of All the Comments",
         plot_bgcolor='#e5ecf6',autosize = T, width = 880, height = 500)

The accuracy of Naive Bayes classifier on the train dataset can be calculated as follow.

NB=NaiveBayesPredictor(Sense,Y)
yhat=NB$Yhat
NBAccuracy=c()
NBAccuracy["Positive"] = 
  mean(na.omit(Y[Y==1]==yhat[Y==1]))
NBAccuracy["Negative"] = 
  mean(na.omit(Y[Y==0]==yhat[Y==0]))
cat(paste0("Overal Accuracy: \n"),mean(yhat==Y),
    paste0("\nAccuracy for different sentiments: \n"), names(NBAccuracy),
    paste0(" \n"),NBAccuracy)

Overal Accuracy: 
 0.8730451 
Accuracy for different sentiments: 
 Positive Negative  
 0.9286314 0.7224118

The second classifier is based on vector space models. We are going to build such a classifier in the following lines of code.

VectorSpaceModel= function(x,y){
  
  pos_center=colMeans(x[y==1,])
  neg_center=colMeans(x[y==0,])
  centers=cbind(pos_center[-1],neg_center[-1])
  dot_prods=x[,-1]%*%centers
  normX=apply(x[,-1],1,function(x)(sqrt(sum(x^2))))
  normCenter=apply(centers,2,function(x)(sqrt(sum(x^2))))
  
  angel_cosine=as.matrix(1/normX)%*%t(as.matrix(1/normCenter))*(dot_prods)
  
  yhat=apply(angel_cosine, 1, function(x) which(max(x)==x))
  yhat[yhat==2]=0
  return(list("Yhat"=yhat,"Centers"=centers))
}

The next function is going to calculates (predicts) the polarity for each comment. Plus, if we input the dependent variable (y) as well it gives us the accuracy of the predictions.

VectorSpacePredictor= function(x,y=NA,centers){
  dot_prods=x[,-1]%*%centers
  normX=apply(x[,-1],1,function(x)(sqrt(sum(x^2))))
  normCenter=apply(centers,2,function(x)(sqrt(sum(x^2))))
  
  angel_cosine=as.matrix(1/normX)%*%t(as.matrix(1/normCenter))*(dot_prods)
  
  yhat=apply(angel_cosine, 1, function(x) which(max(x)==x))
  yhat[yhat==2]=0
  
  accuracy= NA
  
  if(is.na(y)==FALSE && length(y)==length(yhat)){
    accuracy = mean(y==yhat)
  }
  return(list("Yhat"=yhat,"Accuracy"=accuracy))
}

Train accuracy for Vector Space classifier is as follows.

fitVS=VectorSpaceModel(X,Y)
yhat=fitVS$Yhat
VSAccuracy=c()
VSAccuracy["Positive"] = 
  mean(na.omit(Y[Y==1]==yhat[Y==1]))
VSAccuracy["Negative"] = 
  mean(na.omit(Y[Y==0]==yhat[Y==0]))
cat(paste0("Overal Accuracy: \n"),mean(yhat==Y),
    paste0("\nAccuracy for different sentiments: \n"), names(VSAccuracy),
    paste0(" \n"),VSAccuracy)

Overal Accuracy: 
 0.9024839 
Accuracy for different sentiments: 
 Positive Negative  
 0.9601175 0.7463026

The logistic regression classifier accuracy on this dataset can be calculated as follow.

fitGLM=glm(Y~X[,-1],family="binomial")
yhat=round(predict(fitGLM,as.data.frame(X),type="response"),0)
GLMAccuracy=c()
GLMAccuracy["Positive"] = 
  mean(na.omit(Y[Y==1]==yhat[Y==1]))
GLMAccuracy["Negative"] = 
  mean(na.omit(Y[Y==0]==yhat[Y==0]))
cat(paste0("Overal Accuracy: \n"),mean(yhat==Y),
    paste0("\nAccuracy for different sentiments: \n"), names(GLMAccuracy),
    paste0(" \n"),GLMAccuracy)

Overal Accuracy: 
 0.9101503 
Accuracy for different sentiments: 
 Positive Negative  
 0.972712 0.7406143

It is not obvious which method performs better on this dataset. So, we run a simulation of 1000 iterations each time we are going to randomly split the dataset into train and test. Then we build our models based on the train sets and test their performances on the test sets. the results we be stored in a matrix and after the simulation will be visualized.

So, the simulation for the defined methodologies is going to be like this.

So, in the following lines of code, we are going to build a box plot to compare the error of each method.

fig <- plot_ly(type = 'box')
fig <- fig %>% add_boxplot(y = Error[,1], jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
              marker = list(color = 'rgb(7,40,89)'),
              line = list(color = 'rgb(7,40,89)'),
              name = "Vector Spcae Classifier")
fig <- fig %>% add_boxplot(y = Error[,2], jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
              marker = list(color = 'rgb(9,56,125)'),
              line = list(color = 'rgb(9,56,125)'),
              name = "Naive Bayes Classifier")
fig <- fig %>% add_boxplot(y = Error[,3], jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
              marker = list(color = 'rgb(11,64,150)'),
              line = list(color = 'rgb(11,64,150)'),
              name = "Logistic Regression Classifier")
fig %>% layout(autosize = F, width = 920, height = 500)

It seems obvious now that vector space classifier performs slightly better than naive Bayes and significantly better than Logistic regression classifier.